#lang racket


(require (only-in srfi/1 every reverse! partition))

(provide every
         last
         last-pair
         reverse!)

(provide accumulate
         append-first
         butlast
         filter-append-tree
         filter-tree
         firsts
         list-rotate-left
         
         map-append-tree
         map-pair
         map-rest
         map-tree
         
         partition-index
         reduce
         reducer
         repeat
         seconds
         singleton?
         zip)


(define (accumulate fn lst)
  (define (accumulate-aux lst acc)
    (if (empty? lst)
        (list)
        (let ((acc (fn (first lst) acc)))
          (cons
           acc
           (accumulate-aux (rest lst) acc)))))
  (if (empty? lst)
      (list)
      (cons (first lst) (accumulate-aux (rest lst) (first lst)))))

(define (append-first lst)
  (append lst (list (first lst))))

(define (butlast lst)
  (if (empty? (rest lst))
      (list)
      (cons (first lst) (butlast (rest lst)))))

(define (filter-append-tree fn tree)
  (if (empty? tree)
      (list)
      (cond ((list? (first tree))
             (append
              (filter-append-tree fn (first tree))
              (filter-append-tree fn (rest tree))))
            ((fn (first tree))
             (cons
              (first tree)
              (filter-append-tree fn (rest tree))))
            (else
             (filter-append-tree fn (rest tree))))))

(define (filter-tree fn tree)
  (if (empty? tree)
      (list)
      (cond ((list? (first tree))
             (cons
              (filter-tree fn (first tree))
              (filter-tree fn (rest tree))))
            ((fn (first tree))
             (cons
              (first tree)
              (filter-tree fn (rest tree))))
            (else
             (filter-tree fn (rest tree))))))

(define (firsts lst)
  (if (empty? lst)
      (list)
      (cons
       (first lst)
       (seconds (rest lst)))))

(define (list-rotate-left lst i)
  (if (<= i 0)
      lst
      (list-rotate-left (append (rest lst) (list (first lst))) (- i 1))))

(define (map-append-tree fn tree)
  (if (empty? tree)
      (list)
      (if (list? (first tree))
          (cons
           (map-append-tree fn (first tree))
           (map-append-tree fn (rest tree)))
          (append
           (fn (first tree))
           (map-append-tree fn (rest tree))))))

(define (map-pair fn . lsts)
  (define (map-pair-rec fn lsts)
    (if (ormap empty? lsts)
        (list)
        (cons
         (apply fn lsts)
         (map-pair-rec fn (map rest lsts)))))
  (map-pair-rec fn lsts))

(define (map-rest fn lst)
  (define (map-rest-rec lst)
    (if (empty? lst)
        (list)
        (cons
         (first lst)
         (map-rest fn (fn lst)))))
  (map-rest-rec lst))

(define (map-tree fn tree)
  (if (empty? tree)
      (list)
      (if (list? (first tree))
          (cons
           (map-tree fn (first tree))
           (map-tree fn (rest tree)))
          (cons
           (fn (first tree))
           (map-tree fn (rest tree))))))

(define (partition-index pred lst)
  (define (partition-index-aux i aux1 aux2 lst)
    (if (null? lst)
        (values aux1 aux2)
        (let ((e (first lst)))
          (if (pred i e)
              (partition-index-aux (add1 i) (cons e aux1) aux2 (rest lst))
              (partition-index-aux (add1 i) aux1 (cons e aux2) (rest lst))))))
  (partition-index-aux 0 (list) (list) (reverse lst)))

(define (reduce proc lst)
  (if (empty? lst)
      (list)
      (foldl proc (first lst) (rest lst))))

(define (reducer proc lst)
  (if (empty? lst)
      (list)
      (foldr proc (last lst) (butlast lst))))

(define (repeat n lst)
  (define (repeat-n n acc)
    (if (<= n 0)
        acc
        (repeat-n (- n 1) (append acc lst))))
  (if (<= n 1)
      lst
      (repeat-n n (list))))

(define (seconds lst)
  (if (empty? lst)
      (list)
      (firsts (rest lst))))

(define (singleton? lst)
  (and (not (empty? lst)) (empty? (rest lst))))

(define (zip lst1 lst2)
  (define (zip-aux lst1 lst2 lst)
    (if (or (null? lst1) (null? lst2))
        (reverse lst)
        (zip-aux (rest lst1) (rest lst2) (cons (list (first lst1) (first lst2)) lst))))
  (zip-aux lst1 lst2 (list)))